Almathera Ten Pack 3: CDPD 3/Almathera Ten on Ten - Disc 3: CDPD3.iso/scope/051-075/scopedisk70/menumgr/menumanager.rexx

OS/2 REXX Batch file | 1995-03-19 | 21KB | 644 lines

/*-----------------------------Start Rexx Source------------------------------*/
/*
          MenuManager.rexx

                by

           Dan R. Schenck
           7010 E. 77th Place
           Tulsa, OK

           [phone]

           GEnie: D.SCHENCK

                               */

/* Requires rexarplib.library v2.1 */


true = 1
false = 0
WinOpen = false

cdir = Pragma("D")
if right(cdir,1) ~= ":" & right(cdir,1) ~= "/" then cdir = cdir || "/"

if arg() > 0 then
  do
    parse upper arg opt .
    if opt = "-F" then
      do until(DefFile ~= "||||")
        DefFile = GetFile(50,50,cdir,"MenuManager.def","Select MenuManager Definition File")
        if DefFile = "" then exit
        if ~exists(DefFile) then
          do
            call PostError(1,"W")
            DefFile = "||||"
          end
      end
    else call PostError(4,"A")
   end
else
  do
    if exists(cdir||"MenuManager.def") then DefFile = cdir||"MenuManager.def"
    else
      do
        if exists("s:MenuManager.def") then DefFile = "s:MenuManager.def"
        else
          do
            call PostError(1,"A")
            exit
          end
      end
  end
RamFile = "T:$$mmin.tmp"
address command "copy" DefFile "to" RamFile

time2quit = false
sysinfo = "    MenuManager v1.00\"
sysinfo = sysinfo || "       Written by:\       Dan Schenck\\"
sysinfo = sysinfo || "     Tulsa, Oklahoma"
xfile = 'T:$$rx.tmp'
Scmd = "SUBITEM"
Icmd = "ITEM"
Mcmd = "MENU"
action = "."
name = "&"
cmd = "="
help = "$"
IHelp = false
LAct = false
xfilecnt = 0

call PostMsg(50,50,"PATIENCE!\Processing Menu Definition File\\")
rtn = ParseMenu(RamFile)
if rtn > 0 then call PostError(rtn,"A")

call MenuWindow1(MMHOST,MMPORT)
call MenuSetUp
call PostMsg()

  do until(time2quit) /*1*/
    t = waitpkt(MMPORT)
    ii = false
    do until(ii) /*2*/
      p = getpkt(MMPORT)
      if c2d(p) = 0 then break
      command = getarg(p)
      t = reply(p,0)
      ii = true
      select

        when command = "SYSINFO" & ~IHelp & ~LAct then call Request(100,100,sysinfo,,"  OK  ")

        when command = "ITEMHELP" then
          do
            if ~LAct then
              do
                call PostMsg(50,50,"Select Menu Item You Want Help On")
                IHelp = true
              end
          end

        when command = "QUITMM" | command = "CLOSEWINDOW" then call EndAll

        when command = "CHNGMENU" then
          do
            if ~IHelp & ~LAct then
            do
              DefFile = GetFile(50,50,cdir,"MenuManager.def","Select New Definition File")
              if DefFile ~= "" then
                do
                  call PostMsg(50,50,"PATIENCE!\Processing Menu Definition File\\")
                  call RemoveMenu(MMHOST)
                  address command "copy" DefFile "to" RamFile
                  rtn = ParseMenu(RamFile)
                  if rtn > 0 then call PostError(rtn,"A")
                  call MenuSetUp
                  call PostMsg()
                end
            end
          end
        when command = "LISTACTN" then
          do
            if ~IHelp then
              do
                call PostMsg(50,50,"Select Menu Item To List Actions Of")
                LAct = true
              end
          end
        otherwise
          do jj = 1 to 1
            parse var command mtxt "." n "." j "." k
            if k ~= "" then
              do
                if IHelp then
                  do
                    IHelp = false
                    if shelps.n.j.k = 0 then
                      do
                        call PostMsg(50,50,"No Help Available on This Item")
                        call Delay(150)
                        call PostMsg()
                        leave jj
                      end
                    call PostMsg()
                    hmsg = ""
                    do h = 1 to shelps.n.j.k
                      hmsg = hmsg || shelp.n.j.k.h || "\"
                    end
                    call Request(25,25,hmsg,,,"  DONE  ")
                    leave jj
                  end
                if sactions.n.j.k = 1 then
                  do
                    if LAct then
                      do
                        LAct = false
                        call PostMsg()
                        call Request(25,25,saction.n.j.k.1,,,"  DONE  ")
                        leave jj
                      end
                    CurAct = ParseAction(saction.n.j.k.1)
                    address command CurAct
                    leave jj
                  end
                else
                  do
                    if LAct then
                      do
                        LAct = false
                        actmsg = ""
                        do a = 1 to sactions.n.j.k
                          actmsg = actmsg || saction.n.j.k.a || "\"
                        end
                        call PostMsg()
                        call Request(25,25,actmsg,,,"  DONE  ")
                        leave jj
                      end
                    xfilecnt = xfilecnt + 1
                    call open('out',xfile||xfilecnt,"W")
                    do a = 1 to sactions.n.j.k
                      CurAct = ParseAction(saction.n.j.k.a)
                      call writeln('out',CurAct)
                    end
                    call close('out')
                    address command "run" "execute" xfile || xfilecnt
                  end
                leave jj
              end
            else
              do
                if IHelp then
                  do
                    IHelp = false
                    if helps.n.j = 0 then
                      do
                        call PostMsg(50,50,"No Help Available on This Item")
                        call Delay(150)
                        call PostMsg()
                        leave jj
                      end
                    call PostMsg()
                    hmsg = ""
                    do h = 1 to helps.n.j
                      hmsg = hmsg || help.n.j.h || "\"
                    end
                    call Request(25,25,hmsg,,,"  DONE  ")
                    leave jj
                  end
                if actions.n.j = 1 then
                  do
                    if LAct then
                      do
                        LAct = false
                        call PostMsg()
                        call Request(25,25,action.n.j.1,,,"  DONE  ")
                        leave jj
                      end
                    CurAct = ParseAction(action.n.j.1)
                    address command CurAct
                    leave jj
                  end
                else
                  do
                    if LAct then
                      do
                        LAct = false
                        actmsg = ""
                        do a = 1 to actions.n.j
                          actmsg = actmsg || action.n.j.a || "\"
                        end
                        call PostMsg()
                        call Request(25,25,actmsg,,,"  DONE  ")
                        leave jj
                      end
                    xfilecnt = xfilecnt + 1
                    call open('out',xfile||xfilecnt,"W")
                    do a = 1 to actions.n.j
                      CurAct = ParseAction(action.n.j.a)
                      call writeln('out',CurAct)
                    end
                    call close('out')
                    address command "run" "execute" xfile || xfilecnt
                  end
                leave jj
              end
          end
        end
    end
  end
  exit

  ParseAction: procedure  expose PostError cdir WinOpen

  parse arg action

  l = lastpos("[",action)
  do while l ~= 0
    r = index(action,"]",l)
    if r = 0 then call PostError(30,"A")  /* Missing "]" */
    len = r - l -1
    if len <= 0 then call PostError(30,"A")
    str = substr(action,l+1,len)
    do until(dbl = 0)
      dbl = index(str,"!!")
      if dbl > 0 then str = insert('FF'x,delstr(str,dbl,2),dbl-1)
    end
    msg = index(str,"!")
    do until(dbl = 0)
      dbl = index(str,"%%")
      if dbl > 0 then str = insert('FE'x,delstr(str,dbl,2),dbl-1)
    end
    dir = index(str,"%")
    if msg = 0 & dir = 0 then str = Request(50,50,"Enter Parameter","","   OK   "," CANCEL ")
    else if msg > 0 then
      do
        if dir > 0 then
          do
            if msg > dir then
              do
                msgtxt = translate(substr(str,msg+1),"!%",'FFFE'x)
                tmp = msg - dir -1
                if tmp < 0 then call PostError(32,"A")  /* Invalid Action Parameters */
                if tmp = 0 then dirtxt = cdir
                else dirtxt = translate(substr(str,dir+1,tmp),"!%",'FFFE'x)
                if msgtxt = "" then msgtxt = "Select a File"
                if dirtxt = "" then dirtxt = cdir
                str = GetFile(50,50,dirtxt,"",msgtxt)
              end
            else
              do
                dirtxt = translate(substr(str,dir+1),"!%",'FFFE'x)
                tmp = dir - msg -1
                if tmp < 0 then call PostError(32,"A")
                if tmp = 0 then msgtxt = "Select a File"
                else msgtxt = translate(substr(str,msg+1,tmp),"!%",'FFFE'x)
                if dirtxt = "" then dirtxt = cdir
                str = GetFile(50,50,dirtxt,"",msgtxt)
              end
          end
        else
          do
            msgtxt = translate(substr(str,msg+1),"!%",'FFFE'x)
            if msgtxt = "" then msgtxt = "Enter Parameter"
            str = Request(50,50,msgtxt,"","   OK   "," CANCEL ")
          end
      end
      else
        do
          dirtxt = translate(substr(str,dir+1),"!%",'FFFE'x)
          if dirtxt = "" then dirtxt = cdir
          str = GetFile(50,50,dirtxt,"","Select a File")
        end
    if l = 1 then
      do
        if r = length(action) then action = str
        else action = str || substr(action,r+1)
      end
    else
      do
        if r = length(action) then action = substr(action,1,l-1) || str
        else action = substr(action,1,l-1) || str || substr(action,r+1)
      end
    l = lastpos("[",action)
  end
  return action

  EndAll:
  call CloseWindow(MMHOST)
  address command "delete" ">NIL:" xfile||"*" chfile RamFile
  exit

  MenuWindow1:
  arg hostcntl, hostport

  chfile = "T:$$MenuMgr.rexx"
  if ~exists(chfile) then
    do
      call open('out',chfile,"Write")
      call writeln('out',"/* Start Rexx Source */")
      call writeln('out',"x = createhost(" || hostcntl || "," || hostport || ")")
      call close('out')
    end
  address command arun "rx" chfile
  mp = openport(hostport)
  address command "c:WaitForPort" hostcntl
  address command "c:WaitForPort" hostport
  do until(showlist("P",hostcntl) & showlist("P",hostport))
    call delay(10)
  end

  idcmp = 'CLOSEWINDOW+GADGETUP+MENUPICK'
  flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH'

  call OpenWindow(hostcntl,0,0,588,10,idcmp,flags,"MenuManager v1.00 by Dan Schenck")
  WinOpen = true
  return 0

  MenuSetUp:

  call PostMsg(50,50,"\\\Setting Up Menus")
  call AddMenu(MMHOST,"System ")
  call AddItem(MMHOST,"About MenuManager","SYSINFO")
  call AddItem(MMHOST,"Quit MenuManager ","QUITMM","Q")
  call AddMenu(MMHOST,"Options ")
  call AddItem(MMHOST,"Change Menu      ","CHNGMENU",,'FF FE'x)
  call AddItem(MMHOST,"Item Help        ","ITEMHELP","H",'FF FD'x)
  call AddItem(MMHOST,"List Item Actions","LISTACTN",,'FF FB'x)
  do n = 1 to menu_no while menu_no > 0
    call AddMenu(MMHOST,menu.n)
    do j = 1 to items.n while items.n > 0
      if sitems.n.j > 0 then
        do
          call AddItem(MMHOST,item.n.j,msg.n.j)
          do k = 1 to sitems.n.j
            if sitemHK.n.j.k = "" then call AddSubItem(MMHOST,sitem.n.j.k,msg.n.j.k)
            else call AddSubItem(MMHOST,sitem.n.j.k,msg.n.j.k,sitemHK.n.j.k)
          end
        end
      else if itemHK.n.j = "" then call AddItem(MMHOST,item.n.j,msg.n.j)
        else call AddItem(MMHOST,item.n.j,msg.n.j,itemHK.n.j)
    end
  end
  call PostMsg(50,50,"\\\READY!")
  call Delay(25)
  return

PostError:

parse arg errno, severity
call PostMsg() /* close any outstanding messages */
select
  when errno = 1 then
    do
      call PostMsg(50,50,"WARNING!\\Menu Definition File Not Found\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 4 then
    do
      call PostMsg(50,50,"WARNING!\\Illegal Argument to MenuManager\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 10 then
    do
      call PostMsg(50,50,"WARNING!\\Command Unknown or Out Of Sequence\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 12 then
    do
      call PostMsg(50,50,"WARNING!\\Action Field Out Of Sequence\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 14 then
    do
      call PostMsg(50,50,"WARNING!\\Name Field Out Of Sequence\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 16 then
    do
      call PostMsg(50,50,"WARNING!\\Command Field Out Of Sequence\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 18 then
    do
      call PostMsg(50,50,"WARNING!\\Help Field Out Of Sequence\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 20 then
    do
      call PostMsg(50,50,"WARNING!\\Duplicate Hot Key\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 22 then
    do
      call PostMsg(50,50,"WARNING!\\Hot Key Too Long - Invalid\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 30 then
    do
      call PostMsg(50,50,"WARNING!\\Missing or Incorrectly Ordered Brackets\in Action Field\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 32 then
    do
      call PostMsg(50,50,"WARNING!\\Invalid Parameter(s) in Action Field\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  when errno = 99 then
    do
      call PostMsg(50,50,"WARNING!\\System Error\Line Number:  "||CurMenuLine||"\\ABORTING!")
      call Delay(150)
      call PostMsg()
    end
  otherwise return
end

if upper(left(severity,1)) = "A" then
  do
    if WinOpen then call CloseWindow(MMHOST)
    exit
  end

return

/*
  Parse the menu definition file and build menu arrays
*/
ParseMenu:

parse arg MenuDefFile
menu_no = 0    /* Number of menus */
HKey = "HQ"    /* Hot keys string */
CurMenuLine = 0
next = cmd
LastCmd = "null"
call open('in',MenuDefFile,"R")
do until(eof('in'))
  instr = readln('in')
  CurMenuLine = CurMenuLine + 1
  call PostMsg(50,50,"\\\Processing line "||CurMenuLine)
  instr = strip(instr,'L')
  trigger = left(instr,1)
  if trigger = next | (next = action & (trigger = cmd | trigger = help)) then
    do
      select
        when trigger = cmd then
          do
            CmdName = upper(word(substr(instr,2),1))
            select
              when LastCmd = "null" then
                do
                  if CmdName ~= Mcmd then return 10  /* Command unknown or out
                                                        of sequence */
                  else nop
                  LastCmd = Mcmd
                  next = name
                end
              when LastCmd = Mcmd then
                do
                  if CmdName ~= Icmd then return 10
                  else nop
                  LastCmd = Icmd
                  next = name
                end
              when LastCmd = Icmd | LastCmd = Scmd then
                do
                  if CmdName ~= Icmd & CmdName ~= Scmd & CmdName ~= Mcmd then return 10
                  else nop
                  LastCmd = CmdName
                  next = name
                end
              otherwise call PostError(99,"A") /* System Error - ABORT */
            end
          end
        when trigger = name then
          do
            select
              when LastCmd = Mcmd then
                do
                  MenuName = substr(instr,2)
                  menu_no = menu_no + 1
                  menu.menu_no = MenuName
                  items.menu_no = 0
                  next = cmd
                end
              when LastCmd = Icmd then
                do
                  instr = substr(instr,2)
                  parse var instr ItemName "@" HotKey
                  HotKey = strip(HotKey)
                  if length(HotKey) = 1 then
                    do
                      HotKey = upper(HotKey)
                      if index(HKey,HotKey) > 0 then return 20
                      HKey = HKey || HotKey
                    end
                  else
                    if length(HotKey) > 1 then return 22  /* Invalid hot key (too long) */
                  items.menu_no = items.menu_no + 1
                  tmp = items.menu_no
                  item.menu_no.tmp = ItemName
                  itemHK.menu_no.tmp = HotKey
                  sitems.menu_no.tmp = 0
                  actions.menu_no.tmp = 0
                  helps.menu_no.tmp = 0
                  next = action
                end
              when LastCmd = Scmd then
                do
                  instr = substr(instr,2)
                  parse var instr SItemName "@" HotKey
                  HotKey = strip(HotKey)
                  if length(HotKey) = 1 then
                    do
                      HotKey = upper(HotKey)
                      if index(HKey,HotKey) > 0 then return 20
                      HKey = HKey || HotKey
                    end
                  else
                    if length(HotKey) > 1 then return 22  /* Invalid hot key (too long) */
                  tmp = items.menu_no
                  sitems.menu_no.tmp = sitems.menu_no.tmp + 1
                  tmp2 = sitems.menu_no.tmp
                  sitem.menu_no.tmp.tmp2 = SItemName
                  sitemHK.menu_no.tmp.tmp2 = HotKey
                  sactions.menu_no.tmp.tmp2 = 0
                  shelps.menu_no.tmp.tmp2 = 0
                  next = action
                end
              otherwise call PostError(99,"A") /* System Error - ABORT */
            end
          end
        when trigger = action then
          do
            select
              when LastCmd = Icmd then
                do
                  tmp = items.menu_no
                  actions.menu_no.tmp = actions.menu_no.tmp + 1
                  tmp2 = actions.menu_no.tmp
                  action.menu_no.tmp.tmp2 = substr(instr,2)
                end
              when LastCmd = Scmd then
                do
                  tmp = items.menu_no
                  tmp2 = sitems.menu_no.tmp
                  sactions.menu_no.tmp.tmp2 = sactions.menu_no.tmp.tmp2 + 1
                  tmp3 = sactions.menu_no.tmp.tmp2
                  saction.menu_no.tmp.tmp2.tmp3 = substr(instr,2)
                end
              otherwise call PostError(99,"A") /* System Error - ABORT */
            end
          end
        when trigger = help then
          do
            select
              when LastCmd = Icmd then
                do
                  tmp = items.menu_no
                  helps.menu_no.tmp = helps.menu_no.tmp + 1
                  tmp2 = helps.menu_no.tmp
                  help.menu_no.tmp.tmp2 = substr(instr,2)
                end
              when LastCmd = Scmd then
                do
                  tmp = items.menu_no
                  tmp2 = sitems.menu_no.tmp
                  shelps.menu_no.tmp.tmp2 = shelps.menu_no.tmp.tmp2 + 1
                  tmp3 = shelps.menu_no.tmp.tmp2
                  shelp.menu_no.tmp.tmp2.tmp3 = substr(instr,2)
                end
              otherwise call PostError(99,"A") /* System Error - ABORT */
            end
          end
        otherwise call PostError(99,"A") /* System Error - ABORT */
      end
    end
  else
      /* One of the following fields is out of sequence - return an error */
      do
        if trigger = action then return 12 /* Action field out of sequence */
        if trigger = name   then return 14 /* Name field out of sequence */
        if trigger = cmd    then return 16 /* Command field out of sequence */
        if trigger = help   then return 18 /* Help field out of sequence */
      end
  /* Line read in assumed to be a comment - ignore it */
end
call close('in')
return 0

/*-----------------------------End of Rexx Source-----------------------------*/